home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / iconv8_l.arc / PROCS.ARC / pdco.icn < prev    next >
Encoding:
Text File  |  1990-03-05  |  3.3 KB  |  145 lines
  1. ############################################################################
  2. #
  3. #    Name:    pdco.icn
  4. #
  5. #    Title:    Programm-defined control operations
  6. #
  7. #    Author:    Ralph E. Griswold
  8. #
  9. #    Date:    November 16, 1989
  10. #
  11. ############################################################################
  12. #  
  13. #  These procedures use co-expressions to used to model the built-in
  14. #  control structures of Icon and also provide new ones.
  15. #  
  16. #       Alt{e1,e2}         models e1 | e2
  17. #  
  18. #       Colseq{e1,e2, ...} produces results of e1, e2, ... alter-
  19. #                          nately
  20. #  
  21. #       Comseq{e1,e2}      compares result sequences of e1 and e2
  22. #  
  23. #       Cond{e1,e2, ...}   models the generalized Lisp conditional
  24. #  
  25. #       Every{e1,e2}       models every e1 do e2
  26. #  
  27. #       Galt{e1,e2, ...}   models generalized alternation: e1 | e2 |
  28. #                          ...
  29. #  
  30. #       Lcond{e1,e2, ...}  models the Lisp conditional
  31. #  
  32. #       Limit{e1,e2}       models e1 \ e2
  33. #  
  34. #       Ranseq{e1,e2, ...} produces results of e1, e2, ... at random
  35. #  
  36. #       Repalt{e}          models |e
  37. #  
  38. #       Resume{e1,e2,e3}   models every e1 \ e2 do e3
  39. #  
  40. #       Select{e1,e2}      produces results from e1 by position
  41. #                          according to e2
  42. #  
  43. #  Comments:
  44. #
  45. #     Because of the handling of the scope of local identif-
  46. #  iers in co-expressions, expressions in programmer-defined control
  47. #  operations cannot communicate through local identifiers.  Some
  48. #  constructions, such as break and return, cannot be used in argu-
  49. #  ments to programmer-defined control operations.
  50. #  
  51. ############################################################################
  52. #
  53. #  Requires:  co-expressions
  54. #
  55. ############################################################################
  56.  
  57. procedure Alt(L)
  58.    local x
  59.    while x := @L[1] do suspend x
  60.    while x := @L[2] do suspend x
  61. end
  62.  
  63. procedure Colseq(L)
  64.    suspend |@!L
  65. end
  66.  
  67. procedure Comseq(L)
  68.    local x1, x2
  69.    while x1 := @L[1] do
  70.       (x1 === @L[2]) | fail
  71.    if @L[2] then fail else return *L[1]
  72. end
  73.  
  74. procedure Cond(L)
  75.    local i, x
  76.    every i := 1 to *l do
  77.       if x := @L[i] then {
  78.          suspend x
  79.          suspend |@L[i]
  80.          fail
  81.          }
  82. end
  83.  
  84. procedure Every(L)
  85.    while @L[1] do @^L[2]
  86. end
  87.  
  88. procedure Galt(L)
  89.    local C
  90.    every C := !L do suspend |@C
  91. end
  92.  
  93. procedure Lcond(L)
  94.    local i
  95.    every i := 1 to *L by 2 do
  96.       if @L[i] then {
  97.          suspend |@L[i + 1]
  98.          fail
  99.          }
  100. end
  101.  
  102. procedure Limit(L)
  103.    local i, x
  104.    while i := @L[2] do {
  105.       every 1 to i do
  106.          if x := @L[1] then suspend x
  107.          else break
  108.       L[1] := ^L[1]
  109.       }
  110. end
  111.  
  112. procedure Ranseq(L)
  113.    local x
  114.    while x := @?L do suspend x
  115. end
  116.  
  117. procedure Repalt(L)
  118.    local x
  119.    repeat {
  120.       while x := @L[1] do suspend x
  121.       if *L[1] = 0 then fail
  122.       else L[1] := ^L[1]
  123.       }
  124. end
  125.  
  126. procedure Resume(L)
  127.    local i
  128.    while i := @L[2] do {
  129.       L[1] := ^L[1]
  130.       every 1 to i do if @L[1] then @^L[3] else break
  131.       }
  132. end
  133.  
  134. procedure Select(L)
  135.    local i, j, x
  136.    j := 0
  137.    while i := @L[2] do {
  138.       while j < i do
  139.          if x := @L[1] then j +:= 1
  140.          else fail
  141.       if i = j then suspend x
  142.       else stop("selection sequence error")
  143.       }
  144. end
  145.